*************************************************************************
* Title:  FORTRAN Subprogram Cross-Referencer - Main Program.
*
* Produced by: Absoft South, Inc.		Date:  1/14/85
*
* Purpose: To traverse a FORTRAN source file (program or subroutine)
*            and define the subprograms that were called.  This process
*            continues until the entire calling structure of the source
*            is determined.
*
*	   Traversing source code may involve calls to internal
*	     subroutines and functions.  If the user chooses to process
*	     internal routines, the routines are made external by
*	     appending ".ISR" to the routine's name.  As a byproduct
*	     of this operation, a large source file that contains several
*	     internal routines can be divided into its individual
*	     subroutines and functions.  This conversion of internal
*	     routines to external can be disabled if it is not deemed
*	     necessary by the user (see Internal Routines).
*
* Notes:   There are several flags that must be set during the initial
*	     phase of the cross-referencer.  They are set by answering
*	     a number of questions.  Regardless of the answers to any
*	     of the following questions, the source files involved will
*	     not be changed in any way.
*
*
*				User Inquiry
*				---- -------
*	   First, the cross-referencer must know what source code needs to
*	     be traversed.  The main source must be saved in a file that
*	     shares the program's name (only the first 6 characters are
*	     significant).  Also, this file must have a ".FOR" extension.
*	     The main source file is defined with SFGETFILE.
*
*	   The next pertains to the main output of the cross-referencer.
*	     As the routine is traversed, the names of all called routines
*	     are displayed on the screen in an indented format to denote
*	     their nesting level.  This screen output can be saved on
*	     disk by answering "T" to the following question:
*
*		Save the nesting level structure on disk(T/F)?_
*
*	     Default = TRUE
*	     Produces <filename>.LVL
*
*	  While a routine is being traversed, an internal symbol table is
*	    maitained.  This table of called programs can be saved on disk
*	    by answering "T" to the following question:
*
*		Save the symbol table on disk(T/F)?_
*
*	     Default = TRUE
*	     Produces <filename>.SMB
*
*	  One commonly asked question is "Who calls this thing?".  The
*	    cross-referencer will supply this information by answering
*	    "T" to the following question:
*
*		Save the reference table on disk(T/F)?_
*
*	     Default = TRUE
*	     Produces <filename>.REF
*
*	   The internal symbol table can be used to shorten the time it
*	     takes to complete the cross-reference process.  This is
*	     accomplished by eliminating redundant routine traversals.
*	     The nesting level file will flag those redundant calls with
*	     an "*".  This means that by inspecting earlier calls, the
*	     full traversal can be realized.
*
*		Use symbol table(T/F)?_
*
*	     Default = FALSE
*
*	   Conversion of internal subroutines and functions to an external
*	     form is essential to achieving a complete traversal of all
*	     calls pertaining to the main routine in question.  It may be
*	     advantageous to disable this feature though.  Not processing
*	     internal routines reduces traversal time and eliminates the
*	     need for adequate disk space to hold a copy of all internals.
*	     By answering "T" to the following question, the internal
*	     routines will be converted to external, and the traversal
*	     will be as complete as possible.
*
*		Convert internal routines to external(T/F)?_
*
*	     Default = TRUE
*
*
*				Nesting Structure
*				------- ---------
*	   There are 3 types of output from the cross-referencer:
*
*		1) Nesting level structure file (filename.LVL)
*		2) Symbol table file (filename.SMB)
*		3) Internal routines converted to external (subname.ISR)
*
*	   You can produce all (assuming you have the disk space), some, or
*	     none of these files depending on the answers to the questions.
*
*	   The ".LVL" file will produce the following output:
*
*		F    Called Programs
*		-    ---------------
*		F    TEST
*		F    |   TFOR
*		?    |   |   TXXX
*		M    |   |   TM68
*		F    |   TFOR
*		?    |   |   TXXX
*		M    |   |   TM68
*		I    |   INTERN
*		-- End of:  TEST.FOR
*		Total size of all object files used is  302 bytes
*
*	    The "F" column indicates the file type of the called routine.
*	      The possible file types are:
*
*		F - Fortran (".FOR")
*		M - Assembly language (".M68")
*		I - Internal routine (".ISR")
*		? - Source file not found (".???")
*
*	   If the internal symbol table is used to speed up the traversal
*	     process, the new ".LVL" file would appear as follows:
*
*		A F    Called Programs
*		- -    ---------------
*		  F    TEST
*		  F    |   TFOR
*		  ?    |   |   TXXX
*		  M    |   |   TM68
*		* F    |   TFOR
*		  I    |   INTERN
*		-- End of:  TEST.FOR
*		Total size of all object files used is  302 bytes
*
*	   The "A" column flags those files that have already been accessed
*	     and indicate that some of the calling structure is missing.
*
*
*				Symbol Table
*				------ -----
*	   The ".SMB" file may also take on 2 different forms, depending
*	     on whether the symbol table is utilized during the traversal.
*	     In the case where the symbol table is not used, the output
*	     would appear as follows:
*
*		   File      Size of     Number
*		   Name    Object Code  of Calls
*		   ----    -----------  --------
*		INTERN.ISR        0          1
*		  TEST.FOR      192          1
*		  TFOR.FOR       48          2
*		  TM68.M68       62          2
*		  TXXX.???        0          2
*		==============================
*		Totals----      302          8
*		      A total of  5 files.
*
*	   If the symbol table is utilized during the traversal, it would be
*	     very difficult to maintain an accurate count of the number of
*	     times a routine was called.  Therefore, this column is omitted
*	     when the symbol table is used.
*
*	   Also, the object code size for both INTERN.ISR and TXXX.??? are
*	     0.  The size of INTERN.ISR is accounted for by TEST.FOR.  The
*	     object to TXXX.??? was not found, so it is considered undefined.
*
*				Internal Routines
*				-------- --------
*	   Files with the extension of ".ISR" are, as mentioned above,
*	     internal routines that has been made external.  The number of
*	     these is dependent on the source code being traversed.
*
* Warnings/Limitations:
*	   This program requires version 2.1 of the MacFortran toolbx.
*
*	   When entering the main routine name, the extension will
*	     always be assumed ".FOR".  Any other extension is ignored.
*
*	   Since the variable declarations are ignored by this program,
*	     it is impossible to distinguish a function call from an
*	     array assignment.  Therefore, the cross-referencer does not
*	     recognize the use of any function and will not reflect a
*	     function call in either the ".LVL", ".SMB", or ".REF" files.
*
*          There is a nesting limitation of 15 levels in this utility.
*            If your program contains more than 15 nested calls, then
*            simply find all occurrences of the number 15 in this file
*            and replace it with the desired nesting depth.
*
*          There is a limit on the total number of subprograms that can
*            be saved in the symbol table.  This limit of 375 files can
*            be alterred by replacing every occurrence of 375 with the
*            desired symbol table length.
*          
* Variables referenced in MACXRF.COM:
*	OUTPUTLVL    - Save calling structure flag.		(Logical*4)
*	OUTPUTSMB    - Save symbol table flag.			(Logical*4)
*	OUTPUTREF    - Save reference table flag.		(Logical*4)
*	SYMFLG       - Utilize symbol table flag.		(Logical*4)
*	ISRFLG       - Convert internal routines to external.	(Logical*4)
*	MAINPR       - Main program name.			(Char*6)
*	PROGNM       - Active program name.			(Char*6)
*	EXTN         - Active program extension.		(Char*4)
*	FILTYP       - File extension type (I, F, M, or ?).	(Char*1)
*	LVLNUM       - Current nesting level value.		(Integer*4)
*	CURRENTUNIT  - Current input file unit number.		(Integer*4)
*	SYMIDX	     - Array of indices to the symbol table.	(Integer*4)
*	SYMFIL       - Array of filenames in the symbol table.	(Char*6)
*	SYMEXT       - Array of extensions for SYMFIL.		(Char*4)
*	SYMCLL       - Array of call counters for SYMFIL.	(Integer*4)
*	TOTALSYMBOLS - Number of files in the symbol table.	(Integer*4)
*	NESTHEADER   - Illustrates the routine nesting level.	(Char*62)
*	RECURSIVE    - Indicates the current call is recursive.	(Logical*4)
*
* Modification History:  
*
*************************************************************************
      PROGRAM MACXRF
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declaration
*
****************************************************************************
* The size of individual object files.
      INTEGER FILESIZE

* Summed total of all known object files in the calling structure.
      INTEGER TOTALSIZE

* The total number of subroutine calls in the structure.
      INTEGER TOTALCALLS

* Temporary counter variable for reference table output.
      INTEGER REFCTR

* Temporary storage for the symbol table index.
      INTEGER TMPSMBIDX

* Temporary storage for the reference table.
      INTEGER TMPREFIDX

* Temporary string used in reference table output.
      CHARACTER*11 TMPSTR

* Index/Counter variable.
      INTEGER ICNT
      INTEGER JCNT

* Indicates that a file has been located.
      LOGICAL FOUND

* Error value for return from ROM routines.
      INTEGER OSERR

* Function to strip the leading blanks and tabs from a string.
      CHARACTER*132 BYPASS

****************************************************************************
*
* File Parameter Block Definition
*
****************************************************************************
      INCLUDE PARAMS.INC

****************************************************************************
*
* Macintosh ROM Trap Definition
*
****************************************************************************
      INCLUDE TOOLBX.PAR
      INTEGER TOOLBX

****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************

****************************************************************************
*
* Initialize and set defaults
*
****************************************************************************
* The initial program logical I/O unit starts with MAIN.
      CURRENTUNIT=MAIN

* Subprogram call nesting level to 0.
      LVLNUM=0

* The symbol table is empty.
      TOTALSYMBOLS=0

* The total program size is 0.
      TOTALSIZE=0

* There have been no calls made.
      TOTALCALLS=0

* There will be a nesting level file produced.
      OUTPUTLVL=.TRUE.

* There will be a symbol table file produced.
      OUTPUTSMB=.TRUE.

* There will be a reference table file produced.
      OUTPUTREF=.TRUE.

* The symbol table will not be utilized.
      SYMFLG=.FALSE.

* The internal subprograms are to be included in the traversal.
      ISRFLG=.TRUE.

* The first level routine is not considered recursive.
      RECURSIVE=.FALSE.

* The initial file extension and type must always be one of a FORTRAN file.
      EXTN='.FOR'
      FILTYP='F'

* Initialize the call nesting level value.
      NESTHEADER='    |   |   |   |   |   |   |   |   |   |   |   |'//
     +		 '|   |   |   '

* Initialize the subroutine reference list.
      DO (ICNT=1,375)
	DO (JCNT=1,40)
	  REFTBL(ICNT,JCNT)=0
	REPEAT
      REPEAT

* Initialize the file parameter block.
      DO (ICNT=1,80)
        params(ICNT) = 0
      REPEAT

* and the pointer to the file name.
      ionameptr = TOOLBX (PTR,TMPSTR)

****************************************************************************
*
* Get necessary information from the user.
*
****************************************************************************
      CALL QRYUSR

****************************************************************************
*
* See if the main program is anywhere to be found.
*
****************************************************************************
      INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
      IF (.NOT. FOUND) THEN
	WRITE (CONSOLE,*) 'Invalid file specification:',
     +                    TRIM(PROGNM)//EXTN
	STOP
      ENDIF

****************************************************************************
*
* Prepare the files as requested by the user.
*
****************************************************************************
* If a calling structure file is requested...
      IF (OUTPUTLVL) THEN
* ...then, open it.
        OPEN (UNIT=LEVEL,FILE=TRIM(PROGNM)//'.LVL',STATUS='NEW'
     +       ,ACCESS='SEQUENTIAL')
* Initialize the file parameter block.
	TMPSTR = CHAR(LEN(TRIM(PROGNM))+4)//TRIM(PROGNM)//'.LVL'
	OSERR = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
	fdtype = 'TEXT'
	fdcreator = 'EDIT'
	OSERR = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
      ENDIF
* Write the header.
      CALL LVLHDR

* If a symbol table file is requested, then...
      IF (OUTPUTSMB) THEN
* ...then, open it...
        OPEN (UNIT=SYMBOL,FILE=TRIM(PROGNM)//'.SMB',STATUS='NEW'
     +       ,ACCESS='SEQUENTIAL')
* Initialize the file parameter block.
	TMPSTR = CHAR(LEN(TRIM(PROGNM))+4)//TRIM(PROGNM)//'.SMB'
	OSERR = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
	fdtype = 'TEXT'
	fdcreator = 'EDIT'
	OSERR = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
* ...and write the header.
	CALL SMBHDR
      ENDIF

* If a reference table file is requested, then...
      IF (OUTPUTREF) THEN
* ...then, open it...
        OPEN (UNIT=REFERENCE,FILE=TRIM(PROGNM)//'.REF',STATUS='NEW'
     +       ,ACCESS='SEQUENTIAL')
* Initialize the file parameter block.
	TMPSTR = CHAR(LEN(TRIM(PROGNM))+4)//TRIM(PROGNM)//'.REF'
	OSERR = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
	fdtype = 'TEXT'
	fdcreator = 'EDIT'
	OSERR = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))
* ...and write the header.
	CALL REFHDR
      ENDIF

****************************************************************************
*
* Save the main file name for later and add it to the symbol table.
*
****************************************************************************
      MAINPR = PROGNM
      CALL ADDSYM

****************************************************************************
*
* Display the main program name.
*
****************************************************************************
      CALL DOLINE

****************************************************************************
*
* Main line processing loop.
*
****************************************************************************
      CALL DOCALL

****************************************************************************
*
* Build the requested reports from the information gathered.
*
****************************************************************************
* Sort the subroutine names and titles.
      CALL SRTSYM

* Process the symbol and reference tables.
      DO (ICNT=1,TOTALSYMBOLS)
	TMPSMBIDX=SYMIDX(ICNT)
	PROGNM=SYMFIL(TMPSMBIDX)
	EXTN=SYMEXT(TMPSMBIDX)

* Determine the object code size.
	IF ((EXTN = '.ISR') .OR. (EXTN = '.???')) THEN
	  FILESIZE = 0
	ELSE
	  IF (PROGNM = MAINPR) THEN
	    INQUIRE (FILE=TRIM(PROGNM)//' APL',EXIST=FOUND,
     +		     SIZE=FILESIZE)
	    IF (.NOT. FOUND) THEN
	      INQUIRE (FILE=TRIM(PROGNM)//'.SUB',EXIST=FOUND,
     +		       SIZE=FILESIZE)
	    ENDIF
	  ELSE
	    INQUIRE (FILE=TRIM(PROGNM)//'.SUB',EXIST=FOUND,
     +		     SIZE=FILESIZE)
	  ENDIF
	ENDIF

	IF (.NOT. FOUND) FILESIZE = 0

* Output the symbol table data of the current symbol.
	IF (OUTPUTSMB) THEN
	  IF (SYMFLG) THEN
	    WRITE(SYMBOL,10) TRIM(PROGNM)//EXTN,FILESIZE
	  ELSE
	    WRITE(SYMBOL,20) TRIM(PROGNM)//EXTN,FILESIZE,
     +			     SYMCLL(TMPSMBIDX)
	  ENDIF
	ENDIF
	TOTALSIZE=TOTALSIZE+FILESIZE
	TOTALCALLS=TOTALCALLS+SYMCLL(TMPSMBIDX)

* Output the reference list of the current symbol.
	IF (OUTPUTREF) THEN
	  TMPSMBIDX = SYMIDX(ICNT)

* Write the symbol name and ":".
	  PROGNM = SYMFIL(TMPSMBIDX)
	  EXTN = SYMEXT(TMPSMBIDX)
	  TMPSTR = TRIM(PROGNM)//EXTN//':'
	  TYPE (REFERENCE,30) BYPASS(TMPSTR)

	  REFCTR = 0

	  DO (JCNT=1,40)
	    TMPREFIDX = REFTBL(TMPSMBIDX,JCNT)
	    IF (TMPREFIDX = 0) THEN
	      IF (JCNT = 1) TYPE (REFERENCE,*) '  (Main Routine)'
	      EXIT
	    ENDIF
	    IF (REFCTR = 4) THEN
	      REFCTR = 0
	      WRITE (REFERENCE,*)
	      TYPE (REFERENCE,40)
	    ELSE
	      REFCTR = REFCTR + 1
	    ENDIF
	    PROGNM = SYMFIL(TMPREFIDX)
	    EXTN = SYMEXT(TMPREFIDX)
	    TYPE (REFERENCE,50) BYPASS(TRIM(PROGNM)//EXTN)
	  REPEAT

* Seperate each reference list with a blank line.
	  WRITE (REFERENCE,*)
	ENDIF

      REPEAT

****************************************************************************
*
* Terminate the process.
*
****************************************************************************
      IF (OUTPUTSMB) THEN

	IF (SYMFLG) THEN
	  WRITE(SYMBOL,*) '==================='
	  WRITE(SYMBOL,10) 'Totals----',TOTALSIZE
	ELSE
	  WRITE(SYMBOL,*) '=============================='
	  WRITE(SYMBOL,20) 'Totals----',TOTALSIZE,TOTALCALLS
	ENDIF
	WRITE(SYMBOL,*) '      A total of ',TOTALSYMBOLS,' files.'
	CLOSE(UNIT=SYMBOL)
      ENDIF

      IF (OUTPUTREF) THEN
	WRITE(REFERENCE,*)'--- End of: ',TRIM(MAINPR),'.FOR'
	WRITE(REFERENCE,*) '      A total of ',TOTALSYMBOLS,' files.'
	CLOSE(UNIT=REFERENCE)
      ENDIF

      IF (OUTPUTLVL) THEN
	WRITE(LEVEL,*)'--- End of: ',TRIM(MAINPR),'.FOR'
	WRITE(LEVEL,*) 'Total size of all object files used is ',
     +     TOTALSIZE,' bytes'
	CLOSE(UNIT=LEVEL)
      ENDIF

      WRITE(CONSOLE,*)'--- End of: ',TRIM(MAINPR),'.FOR'
      WRITE(CONSOLE,*) 'Total size of all object files used is ',
     +     TOTALSIZE,' bytes'

10    FORMAT (A10,2X,I7)
20    FORMAT (A10,2X,I7,4X,I7)
30    FORMAT (A11)
40    FORMAT (12X)
50    FORMAT (2X,A10)

      END
 
*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - User interface
*
* Produced by: Absoft South, Inc.             Date: 1/15/85
*
* Purpose: Retrieve data from the user that will determine the way
*	     the given program is cross referenced.
*    	    
* Notes:   All input is converted to upper case before assigned to
*	     its associated variable.  With the exception of the
*	     file name, all of the variables have default values in
*	     case the user doesn't answer any of the questions.
*	     The defaults are:
*
*		OUTPUTLVL = .TRUE.
*		OUTPUTSMB = .TRUE.
*		OUTPUTREF = .TRUE.
*		SYMFLG    = .FALSE.
*		ISRFLG    = .TRUE.
*    
* Warnings/Limitations:  
*      
* Calling Conventions:  
*	CALL QRYUSR
*
* Variables referenced in MACXRF.COM:
*	OUTPUTLVL    - Save calling structure flag.		(Logical*4)
*	OUTPUTSMB    - Save symbol table flag.			(Logical*4)
*	OUTPUTREF    - Save reference table flag.		(Logical*4)
*	SYMFLG       - Utilize symbol table flag.		(Logical*4)
*	ISRFLG       - Convert internal routines to external.	(Logical*4)
*	PROGNM       - Active program name.			(Char*6)
*
* Modification History:  
*
*************************************************************************
      SUBROUTINE QRYUSR
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declaration
*
****************************************************************************
      INTEGER*1 REPLY(76)
      INTEGER*2 GOOD
      CHARACTER*4 OSTYPE
      INTEGER*2 VRNUM
      INTEGER*2 VERSION
      CHARACTER*64 FNAME
      INTEGER FLENGTH
      CHARACTER*4 FTYPE

      EQUIVALENCE (REPLY(1), GOOD)
      EQUIVALENCE (REPLY(3), OSTYPE)
      EQUIVALENCE (REPLY(7), VRNUM)
      EQUIVALENCE (REPLY(9), VERSION)
      EQUIVALENCE (REPLY(11), FNAME)

* Position of the SFGETFILE box.
      INTEGER*2 WHERE(2)

* String index to the "." in a file name.
      INTEGER PRGIDX

* Temporary storage for the user input.
      CHARACTER*1 INPCHR

* Function to convert a character string to all upper case.
      CHARACTER*6 UCS

****************************************************************************
*
* Macintosh ROM Trap Definition
*
****************************************************************************
      INCLUDE TOOLBX.PAR
      INTEGER TOOLBX

****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

* Initialize the SFGETFILE box position coordinates.
      DATA WHERE /50,50/

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Get the main program name from the user.
C      TYPE (CONSOLE,*) 'Enter Main Program Filename:'
C      READ (CONSOLE,*) PROGNM

* Define the type to be searched.
      FTYPE = 'TEXT'

* Get the main program name from the user.
      CALL TOOLBX (SFGETFILE,WHERE,0,0,1,TOOLBX(PTR,FTYPE),0,
     +		   REPLY,2)
     
* If not found...
      IF (GOOD = 0) THEN
* ...then, quit.
	STOP
      ELSE
* ...otherwise, define the filename and continue.
	FLENGTH = ICHAR(FNAME(1:1))
	PROGNM = FNAME(2:FLENGTH+1)
      ENDIF

* Make sure it is capitalized and has no extension.
      PROGNM = UCS (PROGNM)
      PRGIDX = INDEX(PROGNM,'.')
      IF (PRGIDX > 0) PROGNM = PROGNM(1:(PRGIDX-1))

* See if the user wants to...
* ...create a file to hold the call structure of the program.
      TYPE (CONSOLE,*) 'Save the nesting level structure on disk(T/F)?'
      READ (CONSOLE,*) INPCHR
      IF (UCS(INPCHR) = 'F') OUTPUTLVL = .FALSE.

* ...create a file to hold a list of routines called.
      TYPE (CONSOLE,*) 'Save the symbol table on disk(T/F)?'
      READ (CONSOLE,*) INPCHR
      IF (UCS(INPCHR) = 'F') OUTPUTSMB = .FALSE.

* ...create a file that lists all calling routines for a called file.
      TYPE (CONSOLE,*) 'Save the reference table on disk(T/F)?'
      READ (CONSOLE,*) INPCHR
      IF (UCS(INPCHR) = 'F') OUTPUTREF = .FALSE.

* ...utilize the internal symbol table during the traversal.
      TYPE (CONSOLE,*) 'Use symbol table(T/F)?'
      READ (CONSOLE,*) INPCHR
      IF (UCS(INPCHR) = 'T') SYMFLG = .TRUE.

* ...process internal subroutines.
      TYPE (CONSOLE,*) 'Convert internal routines to external(T/F)?'
      READ (CONSOLE,*) INPCHR
      IF (UCS(INPCHR) = 'F') ISRFLG = .FALSE.

****************************************************************************
*
* Initialize the window.
*
****************************************************************************
      TYPE(CONSOLE,10)
10    FORMAT(XY(-1,0))

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Call Statement Processor
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To perform all processes on all called subroutines and
*	     functions.  The processes include calling the symbol
*	     table handler, maintaining the program stack, and testing
*	     for recursive calls.
*    	    
* Notes:   If necessary, the file is tested for internal routines.  This
*	     search is not done if ISRFLG is false, or the active file
*	     has the ".ISR" extension (these files will never contain
*	     internal routines).
*
*	   Every line of the source (excluding comments and blank lines) is
*	     tested for a call.  If one is found, the symbol table and other
*	     variables are updated.  Then this procedure calls itself and
*	     process continues.  As files terminate, the recursion unwinds
*	     itself until the main routine is closed.
*    
* Warnings/Limitations: 
*      
* Calling Conventions: 
*	CALL DOCALL
*
* Variables referenced in MACXRF.COM:
*	SYMFLG       - Utilize symbol table flag.		(Logical*4)
*	ISRFLG       - Convert internal routines to external.	(Logical*4)
*	INLINE       - A single source code line.		(Char*132)
*	PROGNM       - Active program name.			(Char*6)
*	EXTN         - Active program extension.		(Char*4)
*	PRSTCK       - Program name nesting stack.		(Char*6)
*	LVLNUM       - Current nesting level value.		(Integer*4)
*	CURRENTUNIT  - Current input file unit number.		(Integer*4)
*	ISSYMBOL     - Denotes PROGNM is in the symbol table.	(Integer*4)
*	RECURSIVE    - Indicates the current call is recursive.	(Logical*4)
*
* Modification History:
*
*************************************************************************
      SUBROUTINE DOCALL
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declaration
*
****************************************************************************
* Temporary storage for the result of ISCALL.
      LOGICAL CLLFLG

* Index/Counter variable.
      INTEGER ICNT

* Function to convert a character string to all upper case.
      CHARACTER*132 UCS

* Function to strip the leading blanks and tabs from a string.
      CHARACTER*132 BYPASS

* Call statement recognition function (logical*4).
      LOGICAL ISCALL

* Function to indicate that the given string is a FORTRAN end statement.
      LOGICAL ENDONLY

****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Initialize the nesting level specific variables.
      CURRENTUNIT=MAIN+LVLNUM
      LVLNUM=LVLNUM+1
      PRSTCK(LVLNUM)=PROGNM

* Open the currently active file.
      OPEN (UNIT=CURRENTUNIT,FILE=TRIM(PROGNM)//EXTN,STATUS='OLD')

* If internal routines are to be made external and this is not ".ISR".
      IF ((ISRFLG) .AND.
     +    (EXTN<>'.ISR')) THEN
	CALL FNDISR
      ENDIF

* Process each source line until the routine has been cross-referenced.
      DO
	READ (CURRENTUNIT,30) INLINE

* If the line is not a comment or blank, process it.
	IF (.NOT. ((INLINE(1:1) = 'C') .OR.
     +	  	   (INLINE(1:1) = '*') .OR.
     +	  	   (INLINE(1:1) = '!') .OR.
     +	  	   (INLINE      = ' '))) THEN

	  INLINE = UCS (BYPASS(INLINE(7:)))
* Search the source line for a subroutine call.
*  Note that ISCALL sets PROGNM, EXTN, and FILTYP.
	  CLLFLG=ISCALL()
	  IF (CLLFLG) THEN
* Check for a recursive call when the symbol table isn't utilized.
	    IF (.NOT. SYMFLG) THEN
	      DO (ICNT=1,LVLNUM)
		IF (PRSTCK(ICNT)=PROGNM) THEN
		  RECURSIVE=.TRUE.
		  EXIT	    
		ENDIF
	      REPEAT
	    ENDIF

* Add the new file name to the symbol table.
	    CALL ADDSYM

* Add the symbol to the reference table.
	    IF (OUTPUTREF) CALL ADDREF

* Display the symbol name such that the nesting level is apparent.
	    CALL DOLINE

* If the call is recursive, don't do anything but reset the flag.
	    IF (RECURSIVE) THEN
	      RECURSIVE=.FALSE.
	    ELSE

* Otherwise, go process the call.
	      IF (((.NOT. SYMFLG) .OR.
     +		   (SYMFLG .AND. (.NOT. ISSYMBOL))) .AND.
     +		   ((FILTYP <> 'M') .AND. (FILTYP <> '?'))) CALL DOCALL
	    ENDIF
	  ELSE

* If the current line marks the end of the routine, then quit.
	    IF (ENDONLY(INLINE)) EXIT
	  ENDIF
	ENDIF
      REPEAT

* Close the currently active file.
      CLOSE (UNIT=CURRENTUNIT)

* Reset the nesting level specific variables.
      LVLNUM=LVLNUM-1
      CURRENTUNIT=(MAIN+LVLNUM)-1

30    FORMAT (A80)
      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Nesting level display
*
* Produced by: Absoft South, Inc.		Date:  1/15/85
*
* Purpose: To display the current subprogram's type (F, M, I, or ?) and
*            its name, indented to represent the current nesting level.
*    	    
* Notes:   It is possible to write this information to a file.  The
*	     decision must be made in QRYUSR.
*    
* Warnings/Limitations:  
*      
* Calling Conventions:  
*	CALL DOLINE
*
* Variables referenced in MACXRF.COM:
*	OUTPUTLVL    - Save calling structure flag.		(Logical*4)
*	SYMFLG       - Utilize symbol table flag.		(Logical*4)
*	PROGNM       - Active program name.			(Char*6)
*	FILTYP       - File extension type (I, F, M, or ?).	(Char*1)
*	LVLNUM       - Current nesting level value.		(Integer*4)
*	ISSYMBOL     - Denotes PROGNM is in the symbol table.	(Integer*4)
*	NESTHEADER   - Illustrates the routine nesting level.	(Char*62)
*	RECURSIVE    - Indicates the current call is recursive.	(Logical*4)
*
* Modification History:  
*************************************************************************
      SUBROUTINE DOLINE
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declaration
*
****************************************************************************
* Temporary storage for an output buffer.
      CHARACTER*71 OUTBUF

****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Define the line to be output.
      IF (SYMFLG) THEN
	IF (ISSYMBOL) THEN
	  OUTBUF='* '//FILTYP//NESTHEADER(1:((LVLNUM+1)*4))//PROGNM
	ELSE
	  OUTBUF='  '//FILTYP//NESTHEADER(1:((LVLNUM+1)*4))//PROGNM
	ENDIF
      ELSE
        OUTBUF=FILTYP//NESTHEADER(1:((LVLNUM+1)*4))//PROGNM
      ENDIF

* Mark the call as recursive if necessary.
      IF (RECURSIVE) OUTBUF=TRIM(OUTBUF)//'(R)'

* Output the line.
      WRITE (CONSOLE,*) TRIM(OUTBUF)
      IF (OUTPUTLVL) THEN
	WRITE (LEVEL,*) TRIM(OUTBUF)
      ENDIF
      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Add Symbol Table Entry
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To make the string held in PROGNM a part of the symbol table,
*	     if it is not already there.
*    	    
* Notes:   This routine sets the value if ISSYMBOL to true if PROGNM is
*	     already part of the symbol table, and false if it was not.
*    
* Warnings/Limitations: 
*      
* Calling Conventions: 
*	CALL ADDSYM
*
* Variables referenced in MACXRF.COM:
*	PROGNM       - Active program name.			(Char*6)
*	EXTN         - Active program extension.		(Char*4)
*	SYMIDX	     - Array of indices to the symbol table.	(Integer*4)
*	SYMFIL       - Array of filenames in the symbol table.	(Char*6)
*	SYMEXT       - Array of extensions for SYMFIL.		(Char*4)
*	SYMCLL       - Array of call counters for SYMFIL.	(Integer*4)
*	TOTALSYMBOLS - Number of files in the symbol table.	(Integer*4)
*	ISSYMBOL     - Denotes PROGNM is in the symbol table.	(Integer*4)
*
* Modification History:
*
*************************************************************************
      SUBROUTINE ADDSYM
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* Index/Counter variable.
      INTEGER ICNT

* Integer function to determine the symbol table index of a routine name.
      INTEGER GETIDX

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Search the symbol table for the string held in PROGNM.
      ICNT = GETIDX (PROGNM)

* If PROGNM is not in the symbol table...
      IF (ICNT = 0) THEN
* ...then, indicate this...
	ISSYMBOL=.FALSE.
* ...point at the next symbol table entry...
	TOTALSYMBOLS=TOTALSYMBOLS+1
* ...and define it.
	SYMIDX(TOTALSYMBOLS)=TOTALSYMBOLS
	SYMFIL(TOTALSYMBOLS)=PROGNM
	SYMEXT(TOTALSYMBOLS)=EXTN
	SYMCLL(TOTALSYMBOLS)=1
      ELSE
* Otherwise, indicate this globally...
	ISSYMBOL=.TRUE.
* ...and increment the call counter.
	SYMCLL(ICNT)=SYMCLL(ICNT)+1
      ENDIF

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Add Reference Table Entry
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To add a calling reference to the reference list of a routine,
*	     if the calling routine is not already part of the reference
*	     list.
*    	    
* Notes:   The structure for the reference table is a list of up to 40
*	     symbol table indices for each symbol table entry.
*    
* Warnings/Limitations: 
*	   Any references by more than 40 seperate routines will be
*	     truncated.
*      
* Calling Conventions: 
*	   CALL ADDREF
*
* Variables referenced in MACXRF.COM:
*	PROGNM       - Active program name.			(Char*6)
*	EXTN         - Active program extension.		(Char*4)
*	SYMIDX	     - Array of indices to the symbol table.	(Integer*4)
*	SYMFIL       - Array of filenames in the symbol table.	(Char*6)
*	SYMEXT       - Array of extensions for SYMFIL.		(Char*4)
*	REFTBL       - Table of calling routine references.	(Char*4)
*	TOTALSYMBOLS - Number of files in the symbol table.	(Integer*4)
*	ISSYMBOL     - Denotes PROGNM is in the symbol table.	(Integer*4)
*
* Modification History:
*
*************************************************************************
      SUBROUTINE ADDREF
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* An index to be saved in the reference table.
      INTEGER REFIDX

* Index/Counter variable.
      INTEGER ICNT
      INTEGER JCNT

* Integer function to determine the symbol table index of a routine name.
      INTEGER GETIDX

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Define the index of the called program.
      ICNT = GETIDX (PROGNM)

* See if this reference has been made before.
      DO (JCNT=1,40)

* If there are no more references in this list, then quit.
	IF (REFTBL(ICNT,JCNT) = 0) EXIT

* If this reference has alredy been made, then return.
	IF (PRSTCK(LVLNUM) = SYMFIL(REFTBL(ICNT,JCNT))) RETURN
      REPEAT

* Define the symbol table index of the calling program and save it.
      REFTBL(ICNT,JCNT) = GETIDX (PRSTCK(LVLNUM))

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Symbol table index search
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To search through the current symbol table for an occurrence
*	     of the given program name.
*    	    
* Notes:   This integer function returns the index of the given program
*	     name, if it is found.  It returns 0 if no match is found.
*    
* Warnings/Limitations:
*	   This routine will not function properly after the symbol
*	     table has been sorted.
*      
* Calling Conventions: 
*	   INDEX = GETIDX (FILNAM)
*
* Calling Parameters:  
* 	Unmodified: FILNAM - The name of the symbol to be found.
*       Modified:   NONE
* 	Returned:   NONE
*
* Variables referenced in MACXRF.COM:
*	SYMFIL       - Array of filenames in the symbol table.	(Char*6)
*	TOTALSYMBOLS - Number of files in the symbol table.	(Integer*4)
*
* Modification History:
*
*************************************************************************
      INTEGER FUNCTION GETIDX (FILNAM)
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* The name of the routine to be found.
      CHARACTER*6 FILNAM

* The table index of the of FILNAM.
      INTEGER TBLIDX

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Check all of the symbol table entries.
      DO (TBLIDX=1,TOTALSYMBOLS)

* If a match is found, define the function value and quit.
	IF (SYMFIL(TBLIDX) = FILNAM) THEN
	  GETIDX=TBLIDX
	  RETURN
	ENDIF
      REPEAT

* If no match is found, set the function accordingly.
      GETIDX=0
      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Symbol table sorter
*
* Produced by: Absoft South, Inc.             Date:  1/14/85
*
* Purpose: To simulataneously sort the 3 arrays that make up the symbol
*	     table.  The 3 arrays are SYMFIL, SYMEXT, and SYMCLL.
*
* Notes:   The symbol table is sorted by implementing a level of
*	     indirection through the use of SYMIDX.  This is a table
*	     of indices that point to a symbol table entry.  Rather than
*	     swapping the elements of 3 arrays, their indices are swapped
*	     to achieve the same effect.
*
* Warnings/Limitations:  NONE
*      
* Calling Conventions:  
*           CALL SRTSYM
*
* Variables referenced in MACXRF.COM:
*	SYMIDX	     - Array of indices to the symbol table.	(Integer*4)
*	SYMFIL       - Array of filenames in the symbol table.	(Char*6)
*	TOTALSYMBOLS - Number of files in the symbol table.	(Integer*4)
*
* Modification History:
*
*************************************************************************
      SUBROUTINE SRTSYM
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* Temporary "current" and "next" symbol table indices.
      INTEGER CURIDX
      INTEGER NXTIDX

* An index to the next symbol table entry to be tested.
      INTEGER NEXT

* An index to the current symbol table entry to be tested.
      INTEGER CURRENT

* Intermediate symbol table length.
      INTEGER TABLELENGTH

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Initialize the variable symbol table length.
      TABLELENGTH=TOTALSYMBOLS

* Repeat the sorting process until all elements have been adjusted.
      DO (TOTALSYMBOLS TIMES)

* Adjust the current symbol table length to reduce the number of entry tests.
	TABLELENGTH=TABLELENGTH-1

* Initialize the index to the current symbol table item.
        CURRENT=0

* Repeat the testing process until the current symbol table length is reached.
	DO (TABLELENGTH TIMES)

* Point to the next pair of symbol table entries.
	  CURRENT=CURRENT+1
	  NEXT=CURRENT+1

* Get the pointers into the symbol table for the current and next indices.
	  CURIDX = SYMIDX(CURRENT)
	  NXTIDX = SYMIDX(NEXT)

* If a swap is necessary...
	  IF(SYMFIL(CURIDX) > SYMFIL(NXTIDX)) THEN
* ... then, swap the symbol table array indices.
	    SYMIDX(NEXT) = CURIDX
	    SYMIDX(CURRENT) = NXTIDX
	  ENDIF
	REPEAT
      REPEAT

      RETURN

      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Nesting Level Header
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To write a header for the nesting level of the calling
*	     structure.
*    	    
* Notes:   This routine writes the nesting level header to the screen and
*	     if OUTPUTLVL is true, the header is saved in a file.
*    
* Warnings/Limitations: NONE
*      
* Calling Conventions: 
*	CALL LVLHDR
*
* Variables referenced in MACXRF.COM:
*	OUTPUTLVL    - Save calling structure flag.		(Logical*4)
*	SYMFLG       - Utilize symbol table flag.		(Logical*4)
*
* Modification History:
*
*************************************************************************
      SUBROUTINE LVLHDR
      IMPLICIT NONE
****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Write the appropriate header depending on the symbol table usage.
      IF (SYMFLG) THEN
	WRITE (CONSOLE,10)
	IF (OUTPUTLVL) WRITE (LEVEL,10)
      ELSE
	WRITE (CONSOLE,20)
	IF (OUTPUTLVL) WRITE (LEVEL,20)
      ENDIF

10    FORMAT ('A F    Called Programs',/,'- -    ---------------')
20    FORMAT ('F    Called Programs',/,'-    ---------------')

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Symbol Table Header
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To write the symbol table header to the symbol table file, if
*	     one was requested.
*    	    
* Notes:   NONE
*    
* Warnings/Limitations: NONE
*      
* Calling Conventions:
*	CALL SMBHDR
*
* Variables referenced in MACXRF.COM:
*	SYMFLG       - Utilize symbol table flag.		(Logical*4)
*
* Modification History:  
*************************************************************************
      SUBROUTINE SMBHDR
      IMPLICIT NONE
****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Write the appropriate header depending on the symbol table usage.
      IF (SYMFLG) THEN
        WRITE(SYMBOL,10)
      ELSE
        WRITE(SYMBOL,20)
      ENDIF

10    FORMAT ('   File      Size of',/,
     +        '   Name    Object Code',/,
     +        '   ----    -----------')
20    FORMAT ('   File      Size of     Number',/,
     +        '   Name    Object Code  of Calls',/,
     +        '   ----    -----------  --------')

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Reference Table Header
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To write the reference table header to the reference table file,
*	     if one was requested.
*    	    
* Notes:   NONE
*    
* Warnings/Limitations: NONE
*      
* Calling Conventions:
*	CALL REFHDR
*
* Variables referenced in MACXRF.COM:
*	OUTPUTREF    - Save reference table flag.		(Logical*4)
*
* Modification History:  
*************************************************************************
      SUBROUTINE REFHDR
      IMPLICIT NONE
****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Global data common block.
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
      WRITE(REFERENCE,10)

10    FORMAT ('Called          Calling',/,
     +        '------          -------')

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Subprogram search routine
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To find all internal subroutines and functions in a FORTRAN
*	     FORTRAN program and make them external by writing the to a
*	     file with the extension ".ISR".
*    	    
* Notes:   This routine finds all internal subroutines and functions in the
*	     active file and copies them into an external file with the
*	     extension ".ISR".  This is accomplished by searching the
*	     source code for a subroutine or function definition statement.
*	     Once found, the file pointer is backed up to the point where
*	     the previous routine was terminated (this causes all leading
*	     comments to be included in the new file) and the source is
*	     copied into the new file.
*    
* Warnings/Limitations: NONE
*      
* Calling Conventions:  
*	   CALL FNDISR
*
* Variables referenced in MACXRF.COM:
*	INLINE       - A single source code line.		(Char*132)
*	PROGNM       - Active program name.			(Char*6)
*	CURRENTUNIT  - Current input file unit number.		(Integer*4)
*
* Modification History:  
*************************************************************************
      SUBROUTINE FNDISR
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* Storage for the internal subroutine name.
      CHARACTER*6 ISRFIL

* Index value used in defining ISRFIL.
      INTEGER ISRIDX

* Source code line counter for leading comment retrieval.
      INTEGER NEWLINECOUNT

* Indicates an end was found, and the ensuing lines are for another file.
      LOGICAL NEWROUTINE

* Temporary string used in reference table output.
      CHARACTER*11 TMPSTR

* Index/Counter Variable.
      INTEGER ICNT

* Functions to look for a subroutine or a function.
      LOGICAL ISSUB
      LOGICAL ISFNC

* Function to convert a character string to all upper case.
      CHARACTER*132 UCS

* Function to strip the leading blanks and tabs from a string.
      CHARACTER*132 BYPASS

* Function to indicate that the given string is a FORTRAN end statement.
      LOGICAL ENDONLY

****************************************************************************
*
* File Parameter Block Definition
*
****************************************************************************
      INCLUDE PARAMS.INC

****************************************************************************
*
* Macintosh ROM Trap Definition
*
****************************************************************************
      INCLUDE TOOLBX.PAR
      INTEGER TOOLBX

****************************************************************************
*
* Constant Definition
*
****************************************************************************
      INCLUDE MACXRF.PAR

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Initialize the file parameter block.
      DO (ICNT=1,80)
        params(ICNT) = 0
      REPEAT

* and the pointer to the file name.
      ionameptr = TOOLBX (PTR,TMPSTR)

      NEWLINECOUNT=0
      NEWROUTINE=.FALSE.
      DO
	READ (CURRENTUNIT,20,END=10) INLINE

* If an end was found and the next routine descriptor has not been, count
*   the number of lines read so they can be output later.
	IF (NEWROUTINE) THEN
	  NEWLINECOUNT=NEWLINECOUNT+1
	ENDIF

* If the line is not a comment or blank, process it.
	IF (.NOT. ((INLINE(1:1) = 'C') .OR.
     +	  	   (INLINE(1:1) = '*') .OR.
     +	  	   (INLINE(1:1) = '!') .OR.
     +	  	   (INLINE      = ' '))) THEN
	  INLINE = UCS (BYPASS(INLINE(7:)))

* If an END is found, indicate that a new routine is being processed.
	  NEWROUTINE=ENDONLY(INLINE)

* If a new routine is identified...
	  IF (ISSUB() .OR. ISFNC()) THEN

* ...then, parse out the routine's name.
	    ISRFIL = INLINE(1:6)
	    ISRIDX = INDEX(ISRFIL,'(')
            IF (ISRIDX > 0) ISRFIL = ISRFIL(1:(ISRIDX-1))

* If this routine definition is not that of the currently active routine...
	    IF (ISRFIL <> PROGNM) THEN

* ...then, back up and get any leading comments.
	      DO (NEWLINECOUNT TIMES)
	        BACKSPACE (CURRENTUNIT)
	      REPEAT
	      NEWLINECOUNT=0

* Open the file where the internal routine will be stored.
	      OPEN (UNIT=ISRUNIT,FILE=TRIM(ISRFIL)//'.ISR',STATUS='NEW')

	      TMPSTR = CHAR(LEN(TRIM(ISRFIL))+4)//TRIM(ISRFIL)//'.ISR'
	      ICNT = TOOLBX (PBGETFILEINFO,TOOLBX(PTR,params))
	      fdtype = 'TEXT'
	      fdcreator = 'EDIT'
	      ICNT = TOOLBX (PBSETFILEINFO,TOOLBX(PTR,params))

* Process each line until the routine's end is found.
	      DO
		READ (CURRENTUNIT,20) INLINE
		IF(INLINE = ' ') THEN
		  WRITE (ISRUNIT,*)
		ELSE
		  WRITE (ISRUNIT,*) TRIM(INLINE)
		  IF (ENDONLY(UCS(BYPASS(INLINE(7:))))) THEN
		    NEWROUTINE=.TRUE.
		    EXIT
		  ENDIF
		ENDIF
	      REPEAT

* Close the external file.
	      CLOSE (UNIT=ISRUNIT)
	    ENDIF
	  ENDIF
	ENDIF
      REPEAT

* Reset the currently active file for the cross-reference traversal.
  10  REWIND (CURRENTUNIT)
  20  FORMAT(A132)

      RETURN

      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - END statement indentifier
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To recognize the end of a FORTRAN program.
*    	    
* Notes:   This logical function will differentiate between the several
*	     catagories of end statements in FORTRAN to locate the final
*	     END statement in the current routine.
*    
* Warnings/Limitations:
*	   Trailing comments will cause this test to fail.
*      
* Calling Conventions: 
*	   FLAG = ENDONLY(STRING)
*
* Calling Parameters:  
*	Unmodified: STRING - The string (of any length) to be tested.
*	Modified:   NONE
*	Returned:   NONE
*
* Variables referenced in MACXRF.COM:
*	NONE
*
* Modification History:
*
*************************************************************************
      LOGICAL FUNCTION ENDONLY (STRING)
      IMPLICIT NONE
****************************************************************************
*
* Subroutine Parameter and Local Variable Declaration
*
****************************************************************************
* Character string to be tested for an END statement.
      CHARACTER*(*) STRING

* String index that references the substring "END".
      INTEGER ENDIDX

****************************************************************************
*
* Executable Code
*
****************************************************************************
      ENDIDX=INDEX(STRING,'END')

* If there is no "END", then quit.
      IF (ENDIDX = 0) THEN
	ENDONLY=.FALSE.
        RETURN
      ENDIF

* If "END" starts at the first character position...
      IF (ENDIDX = 1) THEN

* ...then, see if the rest of the string is blank.
	ENDONLY = (STRING((ENDIDX+3):) = ' ')
      ELSE
* ...otherwise, see if the string before and after "END" is blank.
	ENDONLY = ((STRING(1:(ENDIDX-1)) //
     +              STRING((ENDIDX+3):)) = ' ')
      ENDIF
      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Leading blank strip.
*
* Prouduced by: Absoft South, Inc.            Date:  1/14/85
*
* Purpose: Character function that strips the leading blanks from the
*            character string.
*
* Notes:   This routine can be used with any sized string that is legal
*	     within this compiler.  All leading whitespace (ie - blanks
*	     or tabs) are stripped from the front of the string, leaving
*	     if left justified.
*
* Warnings/Limitations: 
*   
* Calling Conventions: 
*	   DST = BYPASS (SRC)
*
* Calling Parameters:
*	Unmodified: SRC    - Source string to be fixed.
*	Modified:   NONE
*	Returned:   NONE
*
* Variables referenced in MACXRF.COM:
*	NONE
*
* Modification History:
*
*************************************************************************
      CHARACTER*(*) FUNCTION BYPASS (SRC)
      IMPLICIT NONE
****************************************************************************
*
* Subroutine Parameter and Local Storage Declaration
*
****************************************************************************
* Source string to be modified.
      CHARACTER*(*) SRC

* Character index value.
      INTEGER I

****************************************************************************
*
* Executable Code
*
****************************************************************************
      IF (SRC = ' ') RETURN
      BYPASS = SRC
      DO (I=1,LEN(BYPASS))
        IF (.NOT. ((BYPASS(I:I) = " ") .OR.
     +             (BYPASS(I:I) = CHAR(9)))) EXIT
      REPEAT
      BYPASS = BYPASS(I:)
      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Upper case conversion.
*
* Produced by: Absoft South, Inc.             Date:  1/14/85
*
* Purpose: This FORTRAN function performs a conversion of all lower
*	     case characters within a given string to upper case.
*
* Notes:   As with the BYPASS function, this will handle any legal string
*	     legal string length.
*
* Warnings/Limitations: NONE
*
* Calling Conventions:
*	   UPSTR = UCS (STRING)
*
* Calling Parameters:
*	Unmodified: STRING - The string to convert to upper case. (CHAR*132)
*	Modified:   NONE
*	Returned:   NONE
*
* Variables referenced in MACXRF.COM:
*	NONE
*
* Modification History:
*
*************************************************************************
      CHARACTER*(*) FUNCTION UCS(STRING)
      IMPLICIT NONE
*************************************************************************
*
* Variable declarations.
*
*************************************************************************
* Character string to be converted.
      CHARACTER STRING*(*)

* Character string index value.
      INTEGER I

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Initialize the function value.
      UCS = STRING

      DO (I=1,LEN(UCS))
        IF (UCS(I:I) >= "a" .AND. UCS(I:I) <= "z")
     +	  UCS(I:I) = CHAR(ICHAR(UCS(I:I)) - 32)
      REPEAT
      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - CALL Identifier
*
* Produced by: Absoft South, Inc.             Date: 1/15/85
*
* Purpose: To scan the current line for a CALL statement.
*    	    
* Notes:   This routine finds a call statement and parses out the called
*	     program's name.  From this, the extension and file type are
*	     determined.
*    
* Warnings/Limitations: NONE
*
* Calling Conventions: 
*	   FLAG = ISCALL()
*
* Variables referenced in MACXRF.COM:
*	INLINE       - A single source code line.		(Char*132)
*	PROGNM       - Active program name.			(Char*6)
*	EXTN         - Active program extension.		(Char*4)
*	FILTYP       - File extension type (I, F, M, or ?).	(Char*1)
*
* Modification History:  
*
*************************************************************************
      LOGICAL FUNCTION ISCALL
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* A single source code line.
      CHARACTER*1 FIRSTCHAR

* String index used in locating substrings.
      INTEGER LINIDX

* Indicates the success or failure of an INQUIRE statement.
      LOGICAL FOUND

* Function to strip the leading blanks and tabs from a string.
      CHARACTER*132 BYPASS

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Initialize the function result.
      ISCALL=.FALSE.

* Look for the CALL substring.
      LINIDX = INDEX (INLINE,'CALL')

* If this substring exists in the input line...
      IF (LINIDX > 0) THEN

* ...then, try to determine who is being called.
	INLINE = INLINE((LINIDX+4):)
	FIRSTCHAR=INLINE(1:1)

* If the first character is a space of tab...
	IF ((FIRSTCHAR = ' ') .OR.
     +	    (FIRSTCHAR = CHAR(9))) THEN
	  INLINE=BYPASS(INLINE)
	  FIRSTCHAR=INLINE(1:1)

* ...and the next printable character is alphabetic...
	  IF (((FIRSTCHAR>'@') .AND. (FIRSTCHAR<'[')) .OR.
     +	      ((FIRSTCHAR>'`') .AND. (FIRSTCHAR<'{'))) THEN

* ...then, it is a CALL statement.
	    ISCALL=.TRUE.
	    PROGNM=INLINE(1:6)
	    LINIDX = INDEX (PROGNM,'(') - 1
	    IF (LINIDX > 0) PROGNM=PROGNM(1:LINIDX)

************************************************************************ 
*
* Determine the extension of the source code to the file being called.
*                                                                        
************************************************************************ 
* Internal subroutine (".ISR")
	    EXTN='.ISR'
	    INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
	    IF (.NOT. FOUND) THEN

* FORTRAN subroutine (".FOR")
	      EXTN='.FOR'
	      INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
	      IF (.NOT. FOUND) THEN

* Assembly subroutine (".M68")
		EXTN='.M68'
		INQUIRE (FILE=TRIM(PROGNM)//EXTN,EXIST=FOUND)
		IF (.NOT. FOUND) THEN

* No match found (".???")
		  EXTN='.???'
	  	ENDIF
	      ENDIF
	    ENDIF

* Assign a value to the file type now that it is known.
	    FILTYP = EXTN(2:2)
	  ENDIF
	ENDIF
      ENDIF

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Subroutine identifier
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To determine if the given source code line is a subroutine
*	     definition line.
*    	    
* Notes:   This routine assumes that if the first word on the line is
*	     SUBROUTINE, then the line is a subroutine definition.  It
*	     is not case sensitive since the input line is always
*	     converted to upper case.  Also, comments are not processed.
*    
* Warnings/Limitations: 
*      
* Calling Conventions: 
*	   FLAG = ISSUB ()
*
* Variables referenced in MACXRF.COM:
*	INLINE       - A single source code line.		(Char*132)
*
* Modification History:
*
*************************************************************************
      LOGICAL FUNCTION ISSUB ()
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* Function to strip the leading blanks and tabs from a string.
      CHARACTER*132 BYPASS

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* If the first word is SUBROUTINE...
      IF (INLINE(1:10) = 'SUBROUTINE') THEN

* ...then, redefine the line to start at the subroutine's name.
	INLINE = BYPASS(INLINE(11:))
	ISSUB = .TRUE.
      ELSE
	ISSUB = .FALSE.
      ENDIF

      RETURN
      END

*************************************************************************
* Title: FORTRAN Subprogram Cross-Referencer - Function identifier
*
* Produced by: Absoft South, Inc.             Date:  1/15/85
*
* Purpose: To determine if the given source code line is a function
*	     definition line.
*    	    
* Notes:   This routine assumes that if the word FUNCTION is found in
*	     the input line, the line is a function definition statement.
*	     Since comments are ignored, the word function may appear
*	     in one of the full line comments.
*    
* Warnings/Limitations: 
*      
* Calling Conventions: 
*	   FLAG = ISFNC ()
*
* Variables referenced in MACXRF.COM:
*	INLINE       - A single source code line.		(Char*132)
*
* Modification History:
*
*************************************************************************
      LOGICAL FUNCTION ISFNC ()
      IMPLICIT NONE
****************************************************************************
*
* Local Variable and Function Declarations
*
****************************************************************************
* String index used in locating substrings.
      INTEGER LINIDX

* Function to strip the leading blanks and tabs from a string.
      CHARACTER*132 BYPASS

****************************************************************************
*
* Common Storage Definition
*
****************************************************************************
      INCLUDE MACXRF.COM

****************************************************************************
*
* Executable Code
*
****************************************************************************
* Look for the word "FUNCTION".
      LINIDX = INDEX (INLINE,'FUNCTION')

* If the word FUNCTION exists in the current line...
      IF (LINIDX > 1) THEN

* ...then, redefine the line to start at the function's name.
	INLINE = BYPASS(INLINE((LINIDX+8):))
	ISFNC = .TRUE.
      ELSE
	ISFNC = .FALSE.
      ENDIF

      RETURN
      END

* Use this dummy subroutine to force enough heap allocation for 15 open
*   files at once.
      SUBROUTINE DUMMY1
      INTEGER*4 SPACE(300,10)
      COMMON // SPACE
      RETURN
      END
